/*
    REDLisp - interpreter/compiler for new dialect of LISP called REDLisp
    Copyright (C) 2006  Rudolf Olah

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
*/

#include "types.h"

dSymbol *T = new dSymbol ("T");
dList *nil = new dList ();

/***************************
 * MAIN CLASSES
 ***************************/
dObject::dObject ()
{
  type = 'n';
  typeStr = "";
}

string
dObject::toString ()
{
  return 0;
}

dObject::~dObject ()
{
  typeStr.clear ();
}




/***************************
 * NUMBER CLASSES
 ***************************/
#ifdef BIGNUM
dNumber::dNumber (mpf_class var)
{
  if (var.fits_sint_p ())
    {
      regularDecimal = new double (var.get_d ());
      decimal = 0;
    }
  else
    {
      decimal = new mpf_class (var);
      regularDecimal = 0;
    }
  type = 'd';
  typeStr = "DECIMAL";
  integer = 0;
  rational = 0;
  regularInteger = 0;
}
#endif

dNumber::dNumber (double var)
{
  regularDecimal = new double (var);
  type = 'd';
  typeStr = "DECIMAL";
  rational = 0;
  regularInteger = 0;
#ifdef BIGNUM
  integer = 0;
  decimal = 0;
#endif
}

#ifdef BIGNUM
dNumber::dNumber (mpz_class var)
{
  if (var.fits_sint_p ())
    {
      regularInteger = new int (var.get_si ());
      integer = 0;
    }
  else
    {
      integer = new mpz_class (var);
      regularInteger = 0;
    }
  type = 'i';
  typeStr = "INTEGER";
  decimal = 0;
  rational = 0;
  regularDecimal = 0;
}
#endif

dNumber::dNumber (int var)
{
  regularInteger = new int (var);
  type = 'i';
  typeStr = "INTEGER";
  rational = 0;
  regularDecimal = 0;
#ifdef BIGNUM
  integer = 0;
  decimal = 0;
#endif
}

#ifdef BIGNUM
dNumber::dNumber (mpq_class var)
{
  rational = new mpq_class (var);
  integer = 0;
  decimal = 0;
  type = 'r';
  typeStr = "RATIONAL";
  regularInteger = 0;
  regularDecimal = 0;
}
#else
dNumber::dNumber (dRational var)
{
  rational = new dRational (var);
  type = 'r';
  typeStr = "RATIONAL";
  regularInteger = 0;
  regularDecimal = 0;
}
#endif

#ifdef BIGNUM
dNumber::dNumber (mpz_class top, mpz_class bottom)
{
  dNumber (mpq_class (top, bottom));
}
#else
#endif

dNumber::dNumber (string r)
{
  int slash = r.find ('/');
  type = 'r';
  typeStr = "RATIONAL";
#ifdef BIGNUM
  rational = new mpq_class (mpz_class ((char*)r.substr (0, slash).c_str ()),
			    mpz_class ((char*)r.substr (slash+1).c_str ()));
  integer = 0;
  decimal = 0;
#else
  rational = new dRational (r.substr (0, slash), r.substr (slash+1));
#endif
  regularInteger = 0;
  regularDecimal = 0;
}

dNumber::~dNumber ()
{
  if (rational != 0)
    delete rational;
  if (regularInteger != 0)
    delete regularInteger;
  if (regularDecimal != 0)
    delete regularDecimal;
#ifdef BIGNUM
  if (integer != 0)
    delete integer;
  if (decimal != 0)
    delete decimal;
#endif
}

#ifdef BIGNUM
mpf_class
dNumber::Decimal ()
{
  //if (type == 'r')
  //  return rational;
  if (integer != 0)
    return *integer;
  else if (decimal != 0)
    return *decimal;
  else if (regularInteger != 0)
    return *regularInteger;
  return *regularDecimal;
}

mpz_class
dNumber::Integer ()
{
  if (integer != 0)
    return *integer;
  return *regularInteger;
}

mpq_class
dNumber::Rational ()
{
  return *rational;
}
#else
double
dNumber::Decimal ()
{
  if (type == 'i')
    return *regularInteger;
  return *regularDecimal;
}
int
dNumber::Integer ()
{
  return *regularInteger;
}

dRational
dNumber::Rational ()
{
  return *rational;
}
#endif

string
dNumber::toString ()
{
  stringstream buffer;
#ifdef BIGNUM
  if (integer != 0)
    buffer << *integer;
  else if (decimal != 0)
    buffer << *decimal;
  else if (rational != 0)
    buffer << *rational;
  else
#endif
    if (regularInteger != 0)
      buffer << *regularInteger;
    else if (regularDecimal != 0)
      buffer << *regularDecimal;
  return buffer.str ();
}

bool
dNumber::operator== (dNumber &compareTo)
{
  return Decimal () == compareTo.Decimal ();
}

bool
dNumber::operator< (dNumber &compareTo)
{
  return Decimal () < compareTo.Decimal ();
}

bool
dNumber::operator> (dNumber &compareTo)
{
  return Decimal () > compareTo.Decimal ();
}

/***************************
 * SYMBOL CLASS
 ***************************/


/***************************
 * LIST CLASSES
 ***************************/
dNode::dNode (dObject *data, dNode *next)
{
  car = data;
  cdr = next;
}

dNode::~dNode ()
{
}

dList::dList ()
{
  type = 'l';
  typeStr = "LIST";
  first = 0;
  last = 0;
  size = 0;
}

dList::dList (dNode *startNode)
{
  type = 'l';
  typeStr = "LIST";
  first = startNode;
  last = startNode;
  size = 1;
}

dList::dList (dObject *startData)
{
  type = 'l';
  typeStr = "LIST";
  size = 1;
  dList (new dNode (startData, 0));
}

dList::~dList ()
{
  dNode *previous;
  dNode *current = first;
  while (current != 0)
    {
      previous = current;
      current = current->cdr;
      if (previous && current != 0)
	delete previous;
    }
}

void
dList::append (dObject *data)
{
  append (new dNode (data, 0));
}

void
dList::append (dNode *var)
{
  if (first == 0)
    {
      first = var;
      last = var;
    }
  else
    {
      last->cdr = var;
      last = last->cdr;
    }
  size++;
}

void
dList::insert (dObject *data)
{
  insert (new dNode (data, 0));
}

void
dList::insert (dNode *var)
{
  if (first == 0)
    first = last = var;
  else
    {
      var->cdr = first;
      first = var;
    }
  size++;
}

bool
dList::empty ()
{
  if (first == 0)
    return true;
  return false;
}

string
dList::toString ()
{
  if (first == 0)
    {
      char *buffer = new char[4];
      memset (buffer, 0, sizeof (buffer));
      buffer[0] = 'n'; buffer[1] = 'i'; buffer[2] = 'l'; buffer[3] = '\0';
      return buffer;
    }
  else
    {
      string buffer = "";
      dNode *current = first;
      if (current != 0)
	{
	  buffer = "(";
	  while (current != 0 && current->car != 0 && current->cdr != 0)
	    {
	      if (current->car->type == 's')
		{
		  buffer += "\"";
		  buffer += current->car->toString ();
		  buffer += "\"";
		}
	      else if (current->car->type != 'n')
		buffer += current->car->toString ();
	      buffer += " ";
	      current = current->cdr;
	    }
	  if (current->car->type == 's')
	    {
	      buffer += "\"";
	      buffer += current->car->toString ();
	      buffer += "\"";
	    }
	  else if (current->car->type != 'n')
	    buffer += current->car->toString ();
	  buffer += ")";
	}
      return buffer;
    }
}

dObject *
dList::operator[] (int index)
{
  //printf ("size of list: %i\n", size);
  if (size == 0 || first == 0 || (index < 0 && index > size))
    return nil;
  dNode *current = first;
  int i = 0;
  //printf ("operator[]\n%i, %s\n", i, current->car->toString ());
  while (i < index)
    {
      if (current->cdr != 0)
	current = current->cdr;
      else
	return nil;
      i++;
      //printf ("%i, %s\n", i, current->car->toString ());
    }
  if (current == 0)
    printf ("current == 0\n");
  /*if (current->car == 0)
    printf ("current->car == 0\n");*/
  return current->car;
}


/***************************
 * FUNCTION CLASSES
 ***************************/
dLambda::dLambda (dList *vars, dList *body, dString *docString)
{
  // (lambda (variables) "doc" body{(func) (func) (func)})
  type = 'f';
  typeStr = "LAMBDA";
  local_env = new dList ();
  variables = new dList ();
  dObject *item;
  // Parse out the arguments (with their defaults)
#ifdef DEBUG
  if (vars == 0)
    printf ("vars is NULL\n");
  else
    printf ("vars->size: %i\n", vars->size);
#endif
  for (int i = 0; i < vars->size; i++)
    {
      item = (*vars)[i];
#ifdef DEBUG
      printf ("type of variable: %c\n",item->type);
#endif
      if (item->type == 'S' || item->type == 'l')
	variables->append (item);
    }
#ifdef DEBUG
  printf ("Variables!\n");
  debug (variables);
#endif
  // If there's a documentation string, add it
  if (docString != 0)
    doc = docString;
  else
    doc = 0;
  // Add the remaining function body
  form = new dList ();
  for (int j = 0; j < body->size; j++)
    form->append ((*body)[j]);
#ifdef DEBUG
  cout << "Variables: " << variables->toString () << endl;
  printf ("%i parameters\n", variables->size);
  cout << "Form: " << form->toString () << endl;
#endif
}

dLambda::~dLambda ()
{
  if (doc)
    delete doc;
  if (local_env)
    delete local_env;
  if (variables)
    delete variables;
  if (form)
    delete form;
}

dObject *
dLambda::exec (dList *args, dList *env)
{
#ifdef DEBUG
  printf ("Lambda execution...\n");
  debug (args);
  //printf ("%i parameters, %i arguments\n", variables->size, args->size);
#endif
  if (args != 0 && args->size > variables->size)
    return new dError ("too many arguments");
  else
    for (int i = 0; i < variables->size; i++)
      {
	if (args != 0 && (*args)[i] != nil)
	  add_variable ((dSymbol*)(*variables)[i], (*args)[i], local_env);
	else
	  {
	    if ((*variables)[i]->type == 'l')
	      local_env->append ((*variables)[i]);
	    else
	      return new dError ("No default value for parameter #" + i);
	  }
      }
  dObject *blah;
  for (int j = 0; j < form->size; j++)
    {
      blah = eval (((dList*)(*form)[j])->toString (), local_env, env);
      if (blah->type == 'e')
	return (dError*)blah;
    }
  return blah;
}

string
dLambda::toString ()
{
  if (doc)
    return doc->toString ();
  return string ("#LAMBDA");
}

dCompiled::dCompiled (dObject *(*fPtr) (dList *))
{
  type = 'f';
  typeStr = "COMPILED";
  functionPointer = fPtr;
}

dCompiled::~dCompiled ()
{
}

dObject *
dCompiled::exec (dList *args)
{
  return (*functionPointer) (args);
}

string
dCompiled::toString ()
{
  return string ("#COMPILED");
}

/***************************
 * MODULE CLASS
 ***************************/

dModule::dModule (string path)
{
  this->path = path;
}

dModule::~dModule ()
{
  unload ();
  delete [] module;
}

void
dModule::unload ()
{
  if (module != 0)
    #ifdef _WIN32
    FreeLibrary (module);
    #else
    dlclose (module);
    #endif
}

string
dModule::toString ()
{
  return path;
}


/***************************
 * ERROR CLASS
 ***************************/
dError::dError (string msg, string function,
		int lineNumber, dList *args)
{
  this->msg = msg;
  this->function = function;
  this->lineNumber = lineNumber;
  this->args = args;
  type = 'e';
  typeStr = "ERROR";
}

dError::dError (string msg, string function,
		dList *args)
{
  this->msg = msg;
  this->function = function;
  this->lineNumber = -1;
  this->args = args;
  type = 'e';
  typeStr = "ERROR";
}

dError::~dError ()
{
  msg.clear ();
  function.clear ();
  args = 0;
}

string
dError::toString ()
{
  string output = "";
  if (args != 0)
    {
      output += "(";
      if (function != "")
	output += function;
      if (args->size != 0)
	output += args->toString ().substr (1);
      else
	output += ")";
      output += "\n";
    }
  if (lineNumber != -1)
    {
      output += "Line ";
      output += lineNumber;
      output += "\n";
    }
  if (function != "")
    output += function + " ";
  return string("Error: ") + output + msg;
}
